home *** CD-ROM | disk | FTP | other *** search
- ; CAL1.CMD: Interactive Calendar Macro
- ; Asterics "**" replace the current date
- ; in the current month.
- ; Inspired by m.cs.uiuc.edu!reingold who
- ; did a calendar for GNUmacs
- ; (C)opyright 1989 by Ian Ornstein
- ; Last Update Fri Feb 17 1989
- ; Permission is granted to copy, distribute and use this software
- ; wherever Daniel M Lawrence's MicroEMACS is used.
- ;
- execute-file calutil.cmd
- ;
- run save-ctx
- run get-window
- set %calcol 27
- *today
- run get-date
- run month-number
- set %ynum %curyear
- select-buffer "*Calendar*"
- run disp1mon
- beginning-of-file
- search-forward %curday
- 2 backward-character
- overwrite-string "**"
- beginning-of-file
- unmark-buffer
- !goto question
- ;
- *displayit
- run disp1mon
- beginning-of-file
- unmark-buffer
- !goto question
- ;
- *getmonth
- set %mnum @"Enter month number (1-12): "
- !if &and &gre %mnum 0 &les %mnum 13
- !goto getyear
- !else
- set %ans @"Month must be an number from 1 to 12 Press RETURN to Continue"
- !goto getmonth
- !endif
- *getyear
- set %ynum @"Enter year number (yyyy): "
- !if &and &gre %ynum 1988 &les %ynum 2000
- !goto displayit
- !else
- set %ans @"Year must be an number from 1989 to 1999 Press RETURN to Continue"
- !goto getyear
- !endif
- ;
- *help
- set %helpmsg @"n-next, b-back, c-current, o-other, e-exit Press RETURN to Continue"
- !goto question
- ;
- *question
- update-screen
- set %calopt @"Enter Calendar Option (or ? for help): "
- !if &seq %calopt "e"
- !goto finish
- !else
- !if &seq %calopt "b" ;backward
- set %mnum &sub %mnum 1
- !if &equ %mnum 0
- set %mnum 12
- set %ynum &sub %ynum 1
- !endif
- !goto displayit
- !else
- !if &seq %calopt "n" ;forward
- set %mnum &add %mnum 1
- !if &equ %mnum 13
- set %mnum 1
- set %ynum &add %ynum 1
- !endif
- !goto displayit
- !else
- !if &seq %calopt "c" ;current
- !goto today
- !else
- !if &seq %calopt "o" ;other
- !goto getmonth
- !else
- !if &seq %calopt "?" ;help
- !goto help
- !endif
- !endif
- !endif
- !endif
- !endif
- !endif
- ;
- *finish
- next-window
- run restore-ctx
- clear-message-line
- ;
-
-